home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / cfftb1.f < prev    next >
Text File  |  1989-08-14  |  2KB  |  68 lines
  1. *deck cfftb1
  2.       subroutine cfftb1 (n,c,ch,wa,ifac)
  3. C***BEGIN PROLOGUE  CFFTB1
  4. C***REFER TO CFFTB
  5. C***ROUTINES CALLED  PASSB,PASSB5,PASSB3,PASSB2,PASSB4
  6. C***END PROLOGUE  CFFTB1
  7.       dimension       ch(1)      ,c(1)       ,wa(1)      ,ifac(1)
  8. C***FIRST EXECUTABLE STATEMENT  CFFTB1
  9.       nf = ifac(2)
  10.       na = 0
  11.       l1 = 1
  12.       iw = 1
  13.       do 116 k1=1,nf
  14.          ip = ifac(k1+2)
  15.          l2 = ip*l1
  16.          ido = n/l2
  17.          idot = ido+ido
  18.          idl1 = idot*l1
  19.          if (ip .ne. 4) go to 103
  20.          ix2 = iw+idot
  21.          ix3 = ix2+idot
  22.          if (na .ne. 0) go to 101
  23.          call passb4 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3))
  24.          go to 102
  25.   101    call passb4 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3))
  26.   102    na = 1-na
  27.          go to 115
  28.   103    if (ip .ne. 2) go to 106
  29.          if (na .ne. 0) go to 104
  30.          call passb2 (idot,l1,c,ch,wa(iw))
  31.          go to 105
  32.   104    call passb2 (idot,l1,ch,c,wa(iw))
  33.   105    na = 1-na
  34.          go to 115
  35.   106    if (ip .ne. 3) go to 109
  36.          ix2 = iw+idot
  37.          if (na .ne. 0) go to 107
  38.          call passb3 (idot,l1,c,ch,wa(iw),wa(ix2))
  39.          go to 108
  40.   107    call passb3 (idot,l1,ch,c,wa(iw),wa(ix2))
  41.   108    na = 1-na
  42.          go to 115
  43.   109    if (ip .ne. 5) go to 112
  44.          ix2 = iw+idot
  45.          ix3 = ix2+idot
  46.          ix4 = ix3+idot
  47.          if (na .ne. 0) go to 110
  48.          call passb5 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  49.          go to 111
  50.   110    call passb5 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  51.   111    na = 1-na
  52.          go to 115
  53.   112    if (na .ne. 0) go to 113
  54.          call passb (nac,idot,ip,l1,idl1,c,c,c,ch,ch,wa(iw))
  55.          go to 114
  56.   113    call passb (nac,idot,ip,l1,idl1,ch,ch,ch,c,c,wa(iw))
  57.   114    if (nac .ne. 0) na = 1-na
  58.   115    l1 = l2
  59.          iw = iw+(ip-1)*idot
  60.   116 continue
  61.       if (na .eq. 0) return
  62.       n2 = n+n
  63.       do 117 i=1,n2
  64.          c(i) = ch(i)
  65.   117 continue
  66.       return
  67.       end
  68.